home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / compiled000 / MAPIT.for
Text File  |  1991-04-23  |  8KB  |  270 lines
  1.         SUBROUTINE MAPIT(XLOW,XHIGH,YLOW,YHIGH,XLAB,YLAB,TITLE,IAXES)
  2.         IMPLICIT NONE
  3.         INCLUDE DIGLIB$KOM:PLTCOM.PRM
  4.         INCLUDE DIGLIB$KOM:PLTSIZ.PRM
  5.         INCLUDE DIGLIB$KOM:PLTCLP.PRM
  6.         INCLUDE DIGLIB$KOM:PLTPRM.PRM
  7.         INCLUDE DIGLIB$KOM:GCLTYP.PRM
  8. C
  9.     EXTERNAL LEN
  10.         CHARACTER*1 XLAB(2), YLAB(2), TITLE(2)
  11.         CHARACTER*1 NUMBR(14)
  12.         LOGICAL*1 LOGXX, LOGYY, LOGT, LRMTEX, LSHORT, LRAGGD, IAND
  13.         REAL*4 ZLOG(8),TMINLD,SHORTF,XTMIN,XTMAX,XTICK,YTMIN,YTMAX
  14.         REAL*4 YTICK,VX,VY,TEMP,TENEXP,X,Y,TCKSGN,TICKSP,LN
  15.         INTEGER NUMTK,IXPWR,IYPWR,MXLAB,N,J,ILABSZ
  16. C
  17.         DATA ZLOG /0.3010, 0.4771, 0.6021, 0.6990, 0.7782, 0.8451,
  18.      1   0.9031, 0.9542 /
  19. C       MINIMUM DISTANCE BETWEEN SHORT TICKS (1 MM)
  20.         DATA TMINLD /0.1/
  21. C       SHORT TICKS = TICKLN/SHORTF
  22.         DATA SHORTF /2.0/
  23. C
  24. C       SET LOGX AND LOGY TO FALSE FOR OUR USAGE OF SCALE
  25. C
  26.         LOGX = .FALSE.
  27.         LOGY = .FALSE.
  28. C
  29. C       SEE WHAT TYPE OF AXES ARE DESIRED
  30. C
  31.         LOGXX = IAND(IAXES,1) .NE. 0
  32.         LOGYY = IAND(IAXES,2) .NE. 0
  33.         LRAGGD = IAND(IAXES,256) .NE. 0
  34. C
  35. C       DO THE AXES SCALING
  36. C
  37.         NUMTK = MIN0(10,INT(XVLEN/((ILABSZ()+1.0)*CXSIZE)))
  38.         IF (LOGXX) GO TO 20
  39.         LSHORT = IAND(IAXES,16) .NE. 0
  40.         CALL AXIS(XLOW,XHIGH,NUMTK,LSHORT,LRAGGD,XMIN,XMAX,XTMIN,XTMAX,
  41.      1   XTICK,IXPWR)
  42.         GO TO 40
  43. 20      CALL LAXIS(XLOW,XHIGH,NUMTK,XMIN,XMAX,XTICK)
  44.         XTMIN = XMIN
  45.         XTMAX = XMAX
  46.         IXPWR = 0
  47. 40      NUMTK = MIN0(10,INT(YVLEN/(3.0*CYSIZE)))
  48.         IF (LOGYY) GO TO 60
  49.         LSHORT = IAND(IAXES,32) .NE. 0
  50.         CALL AXIS(YLOW,YHIGH,NUMTK,LSHORT,LRAGGD,YMIN,YMAX,YTMIN,YTMAX,
  51.      1   YTICK,IYPWR)
  52.         GO TO 80
  53. 60      CALL LAXIS(YLOW,YHIGH,NUMTK,YMIN,YMAX,YTICK)
  54.         YTMIN = YMIN
  55.         YTMAX = YMAX
  56.         IYPWR = 0
  57. 80      CONTINUE
  58. C
  59. C       SET UP SCALING FACTORS FOR SCALE
  60. C
  61.         UX0 = XMIN
  62.         UDX = XMAX - XMIN
  63.         UY0 = YMIN
  64.         UDY = YMAX - YMIN
  65. C
  66. C       ********** DRAW Y AXES **********
  67. C
  68.         CALL GSSETC(CYSIZE,0.0)
  69.         LOGT = .FALSE.
  70.         IF (.NOT. LOGYY .OR. YTICK .NE. 1.0) GO TO 90
  71.         CALL SCALE(XMIN,YMIN,VX,TEMP)
  72.         CALL SCALE(XMIN,YMIN+1.0-ZLOG(8),VX,VY)
  73.         IF ((VY-TEMP) .GE. TMINLD) LOGT = .TRUE.
  74. 90      CONTINUE
  75. C
  76. C       DRAW Y AXIS LINE
  77. C
  78.         MXLAB = 3
  79.         TENEXP = 10.0**IYPWR
  80.         X = XMIN
  81. C       TICK SPACING
  82.         TICKSP = AMAX1(0.0,TICKLN)
  83.         IF (IAND(IAXES,64) .NE. 0) YVLEN = YVLEN - TICKSP
  84. C       TICKS TO LEFT FOR LEFT Y AXIS
  85.         TCKSGN = -TICKLN
  86. 100     CONTINUE
  87.         CALL SCALE(X,YMAX,VX,VY)
  88.         CALL GSMOVE(VX,VY)
  89.         CALL SCALE(X,YMIN,VX,VY)
  90.         CALL GSDRAW(VX,VY)
  91. C
  92. C       DRAW AND LABEL Y AXIS TICKS
  93. C
  94.         Y = YTMIN
  95.         N = (YTMAX-YTMIN)/YTICK + 1.1
  96. 110     CONTINUE
  97.         CALL SCALE(X,Y*TENEXP,VX,VY)
  98.         CALL GSMOVE(VX,VY)
  99.         CALL GSDRAW(VX+TCKSGN,VY)
  100.         IF (X .EQ. XMAX) GO TO 185
  101.         IF (IAND(IAXES,1024) .NE. 0) GO TO 183
  102. C
  103. C       PLACE THE APPROPIATE LABEL
  104. C
  105.         IF (LOGYY) GO TO 160
  106.         CALL LINLAB(INT(Y),IYPWR,NUMBR,LRMTEX)
  107.         GO TO 180
  108. 160     CALL LOGLAB(INT(Y),NUMBR)
  109. 180     LN = LEN(NUMBR)
  110.         MXLAB = MAX0(MXLAB,LN)
  111.         CALL GSMOVE(VX-TICKSP-CXSIZE*(LN+0.25),VY-CYSIZE/2.0)
  112.         CALL GSPSTR(NUMBR)
  113. C
  114. C       ADD GRID LINE AT TICK IF DESIRED
  115. C
  116. 183     CONTINUE
  117.         IF (IAND(IAXES,8) .EQ. 0) GO TO 185
  118.         CALL GSLTYP(3)
  119.         CALL GSMOVE(VX,VY)
  120.         CALL SCALE(XMAX,Y*TENEXP,VX,VY)
  121.         CALL GSDRAW(VX,VY)
  122.         CALL GSLTYP(1)
  123. 185     CONTINUE
  124. C
  125. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  126. C
  127.         IF ((.NOT. LOGT) .OR. (Y .EQ. YTMAX)) GO TO 200
  128.         DO 190 J = 1, 8
  129.         CALL SCALE(X,Y+ZLOG(J),VX,VY)
  130.         CALL GSMOVE(VX,VY)
  131. 190     CALL GSDRAW(VX+TCKSGN/SHORTF,VY)
  132. 200     CONTINUE
  133.         Y = Y + YTICK
  134.         N = N-1
  135.         IF (N .GT. 0) GO TO 110
  136.         IF (X .EQ. XMAX) GO TO 300
  137. C
  138. C       IF LINEAR AXIS, PLACE REMOTE EXPONENT IF NEEDED
  139. C
  140.         IF (LOGYY .OR. (.NOT. LRMTEX)) GO TO 260
  141.         IF (IAND(IAXES,1024) .NE. 0) GO TO 260
  142.         CALL SCALE(XMIN,(YTMIN+YTICK/2.0)*TENEXP,VX,VY)
  143.         CALL SCOPY('E'//CHAR(0),NUMBR)
  144.         CALL NUMSTR(IYPWR,NUMBR(2))
  145.         CALL GSMOVE(VX-CXSIZE*(LEN(NUMBR)+0.5),VY-CYSIZE/2.0)
  146.         CALL GSPSTR(NUMBR)
  147. C
  148. C       NOW PLACE Y LABLE
  149. C
  150. 260     CALL SCALE(XMIN,(YMIN+YMAX)/2.0,VX,VY)
  151.         CALL GSMOVE(VX-(MXLAB+0.25)*CXSIZE-TICKSP-CYSIZE,
  152.      1   VY-CXSIZE*LEN(YLAB)/2.0)
  153.         CALL GSSETC(CYSIZE,90.0)
  154.         CALL GSPSTR(YLAB)
  155.         CALL GSSETC(CYSIZE,0.0)
  156.         IF (IAND(IAXES,128) .EQ. 0) GO TO 300
  157.         X = XMAX
  158.         TCKSGN = TICKLN
  159.         GO TO 100
  160. 300     CONTINUE
  161. C
  162. C       ********** DRAW X AXIS **********
  163. C
  164.         LOGT = .FALSE.
  165.         IF (.NOT. LOGXX .OR. XTICK .NE. 1.0) GO TO 310
  166.         CALL SCALE(XMIN,YMIN,TEMP,VY)
  167.         CALL SCALE(XMIN+1.0-ZLOG(8),YMIN,VX,VY)
  168.         IF ((VX-TEMP) .GE. TMINLD) LOGT = .TRUE.
  169. 310     CONTINUE
  170. C
  171. C       DRAW X AXIS LINE
  172. C
  173.         Y = YMIN
  174.         TCKSGN = -TICKLN
  175.         TENEXP = 10.0**IXPWR
  176. C       TICK SPACING
  177.         TICKSP = AMAX1(0.5*CYSIZE,TICKLN)
  178. 320     CONTINUE
  179.         CALL SCALE(XMIN,Y,VX,VY)
  180.         CALL GSMOVE(VX,VY)
  181.         CALL SCALE(XMAX,Y,VX,VY)
  182.         CALL GSDRAW(VX,VY)
  183. C
  184. C       DRAW AND LABEL X AXIS TICKS
  185. C
  186.         X = XTMIN
  187.         N = (XTMAX-XTMIN)/XTICK + 1.1
  188. 400     CONTINUE
  189.         CALL SCALE(X*TENEXP,Y,VX,VY)
  190.         CALL GSMOVE(VX,VY)
  191.         CALL GSDRAW(VX,VY+TCKSGN)
  192.         IF (Y .EQ. YMAX) GO TO 430
  193.         IF (IAND(IAXES,512) .NE. 0) GO TO 423
  194.         IF (LOGXX) GO TO 410
  195.         CALL LINLAB(INT(X),IXPWR,NUMBR,LRMTEX)
  196.         GO TO 420
  197. 410     CALL LOGLAB(INT(X),NUMBR)
  198. 420     CALL GSMOVE(VX-CXSIZE*LEN(NUMBR)/2.0,VY-TICKSP-1.5*CYSIZE)
  199.         CALL GSPSTR(NUMBR)
  200. C
  201. C       ADD GRID LINE AT TICK IF DESIRED
  202. C
  203. 423     CONTINUE
  204.         IF (IAND(IAXES,4) .EQ. 0) GO TO 430
  205.         CALL GSLTYP(3)
  206.         CALL GSMOVE(VX,VY)
  207.         CALL SCALE(X*TENEXP,YMAX,VX,VY)
  208.         CALL GSDRAW(VX,VY)
  209.         CALL GSLTYP(1)
  210. 430     CONTINUE
  211. C
  212. C       DO EXTRA TICKING IF EXTRA TICKS WILL BE FAR ENOUGH APART
  213. C
  214.         IF ((.NOT. LOGT) .OR. (X .EQ. XTMAX)) GO TO 490
  215.         DO 450 J = 1, 8
  216.         CALL SCALE(X+ZLOG(J),Y,VX,VY)
  217.         CALL GSMOVE(VX,VY)
  218.         CALL GSDRAW(VX,VY+TCKSGN/SHORTF)
  219. 450     CONTINUE
  220. 490     CONTINUE
  221.         X = X + XTICK
  222.         N = N-1
  223.         IF (N .GT. 0) GO TO 400
  224.         IF (Y .EQ. YMAX) GO TO 590
  225. C
  226. C       NOW PLACE REMOTE EXPONENT IF NEEDED ON LINEAR AXIS
  227. C
  228.         IF (LOGXX .OR. (.NOT. LRMTEX)) GO TO 520
  229.         IF (IAND(IAXES,512) .NE. 0) GO TO 520
  230.         CALL SCALE(XMIN,YMIN,VX,VY)
  231.         CALL SCOPY('E'//CHAR(0),NUMBR)
  232.         CALL NUMSTR(IXPWR,NUMBR(2))
  233.         CALL GSMOVE(VX+3*CXSIZE,VY-TICKSP-2.75*CYSIZE)
  234.         CALL GSPSTR(NUMBR)
  235. C
  236. C       NOW PLACE X AXIS LABLE
  237. C
  238. 520     CALL SCALE((XMIN+XMAX)/2.0,YMIN,VX,VY)
  239.         CALL GSMOVE(VX-CXSIZE*LEN(XLAB)/2.0,VY-TICKSP-4.0*CYSIZE)
  240.         CALL GSPSTR(XLAB)
  241.         IF (IAND(IAXES,64) .EQ. 0) GO TO 590
  242.         Y = YMAX
  243.         TCKSGN = TICKLN
  244.         GO TO 320
  245. 590     CONTINUE
  246. C
  247. C       ********** PLACE TITLE **********
  248. C
  249.         CALL SCALE((XMIN+XMAX)/2.0,YMAX,VX,VY)
  250.         TCKSGN = 0.0
  251.         IF (IAND(IAXES,64) .NE. 0) TCKSGN = TICKSP
  252.         CALL GSMOVE(VX-CXSIZE*LEN(TITLE)/2.0,VY+TCKSGN+CYSIZE)
  253.         CALL GSPSTR(TITLE)
  254. C
  255. C       MAKE SURE "PLTCLP" CONTAINS LIMITS PICKED BY MAPIT.   ONLY MAINTAINED
  256. C       FOR CALLERS INFO.
  257. C
  258.         IF (.NOT. LOGXX) GO TO 610
  259.                 XMIN = 10.0**XMIN
  260.                 XMAX = 10.0**XMAX
  261.                 LOGX = .TRUE.
  262. 610     CONTINUE
  263.         IF (.NOT. LOGYY) GO TO 620
  264.                 YMIN = 10.0**YMIN
  265.                 YMAX = 10.0**YMAX
  266.                 LOGY = .TRUE.
  267. 620     CONTINUE
  268.         RETURN
  269.         END
  270.